ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Tools/PostRez.p

Text File | 1990-10-25 | 5.9 KB | 253 lines | [TEXT/MPS ]

{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}

{------------------------------------------------------------------------------

FILE PostRez.p
 Copyright Apple Computer, Inc. 1986 - 1990
 All rights reserved.

NAME
 PostRez -- post process menu resources

SYNOPSIS
 Looks at resorce file for cmnu resorces and
   converts them to MENU resources while
   extracting command numbers to create the
   kMNTBbyCmdNumber resource

------------------------------------------------------------------------------}
PROGRAM PostRez;

    USES
        { • MacApp }
        UMacApp,
        UAssociation,

        { • Building Blocks }
        UMPWTool,

        { • Required for this unit's interface }

        { • Implementation use }
        Memory, CursorCtl, Signal, PasLibIntf, IntEnv, Resources, ToolUtils, OSUtils;

    CONST
        kInitialSize        = 100;

    TYPE
        tableRec            = RECORD
            cmd:                integer;
            menu:                integer;
            item:                integer;
            END;
        Table                = ARRAY [1..1] OF tableRec;
        TablePtr            = ^Table;
        TableHandle            = ^TablePtr;

        TPostRezTool        = OBJECT (TMPWTool)
            fTableIndex:        integer;
            fIncSize:            integer;
            fTableHandle:        TableHandle;

            fResFileName:        str255;

            PROCEDURE TPostRezTool.IPostRezTool;
            PROCEDURE TPostRezTool.AddToTable(commandNumber, menuNumber, itemNumber: integer);
            PROCEDURE TPostRezTool.DoProcessFileArg(arg: str255); OVERRIDE;
            PROCEDURE TPostRezTool.DoToolAction; OVERRIDE;
            PROCEDURE TPostRezTool.DoAutoMagicCreatorAndBundle;

            END;

    VAR
        gPostRezTool:        TPostRezTool;

{--------------------------------------------------------------------------------------------------}
        {$S TInit}

    PROCEDURE TPostRezTool.IPostRezTool;

        BEGIN
        ITool;

        fResFileName := '';
        fTableIndex := 0;
        fIncSize := 0;
        fTableHandle := TableHandle(NewHandle(kInitialSize * sizeof(tableRec)));
        FailNil(fTableHandle);
        END;

{--------------------------------------------------------------------------------------------------}
    {$S TInit}

    PROCEDURE TPostRezTool.DoProcessFileArg(arg: str255);

        BEGIN
        IF fResFileName <> '' THEN
            Stop('Sorry… only smart enough to process one file')
        ELSE
            fResFileName := arg;
        END;

{--------------------------------------------------------------------------------------------------}
    {$S TRes}

    PROCEDURE TPostRezTool.AddToTable(commandNumber, menuNumber, itemNumber: integer);

        BEGIN
        IF fProgress THEN
            BEGIN
            Write('In add to table, cmd,menu,item= ', commandNumber: 5, menuNumber: 5, itemNumber:
                  5);
            WriteLn('  index = ', fTableIndex + 1: 1);
            END;
        fTableIndex := fTableIndex + 1;
        fIncSize := fIncSize + 1;
        IF fIncSize > kInitialSize THEN
            BEGIN
            fIncSize := 0;
            SetHandleSize(Handle(fTableHandle), (fTableIndex + kInitialSize) * sizeof(tableRec));
            FailMemError;
            END;
        WITH fTableHandle^^[fTableIndex] DO
            BEGIN
            cmd := commandNumber;
            menu := menuNumber;
            item := itemNumber;
            END;
        END;

{--------------------------------------------------------------------------------------------------}
    {$S TRes}

    PROCEDURE CallAddToTable(commandNumber, menuNumber, itemNumber: integer);

        BEGIN
        gPostRezTool.AddToTable(commandNumber, menuNumber, itemNumber);
        END;

{--------------------------------------------------------------------------------------------------}
    {$S TRes}

    PROCEDURE TPostRezTool.DoAutoMagicCreatorAndBundle;

        CONST
            bundleType            = 'BNDL';
            bundleID            = 128;

        TYPE
            OSTypePtr             = ^OSType;
            OSTypeHandle        = ^OSTypePtr;

        VAR
            theFInfo:            FInfo;
            theBundle:            OSTypeHandle;
            aName:                str255;

        BEGIN
        aName := fResFileName;
        FailOSErr(GetFInfo(aName, 0, theFInfo));
        theBundle := OSTypeHandle(Get1IndResource(bundleType, 1));
        IF theBundle <> NIL THEN
            BEGIN
            theFInfo.fdCreator := theBundle^^;
            theFInfo.fdFlags := BOR(theFInfo.fdFlags, fHasBundle);
            END
        ELSE
            BEGIN
            theFInfo.fdCreator := '????';
            theFInfo.fdFlags := BAND(theFInfo.fdFlags, BNOT(fHasBundle));
            END;
        FailOSErr(SetFInfo(aName, 0, theFInfo));
        END;

{--------------------------------------------------------------------------------------------------}
    {$S TRes}

    PROCEDURE ConvertToMenu(cmnuHandle: Handle; menuID: integer; proc: ProcPtr);
        EXTERNAL;

    PROCEDURE TPostRezTool.DoToolAction;

        VAR
            i, j, num:            integer;
            temp:                tableRec;
            tempH:                Handle;
            cmnuHandle:                Handle;
            menuID:             integer;
            menuType:            ResType;
            name:                str255;
            ref:                integer;
            aName:                str255;

        BEGIN
        IF fResFileName = '' THEN
            Stop('No filename specified');

        aName := fResFileName;

        SetResLoad(FALSE);                                { avoid preloads }
        ref := OpenResFile(aName);
        SetResLoad(TRUE);
        IF ref = - 1 THEN
            FailResError;
        num := CountResources('cmnu');
        FailResError;
        FOR i := num DOWNTO 1 DO                        {do backwords, since we are removing as we
                                                         go}
            BEGIN
            cmnuHandle := GetIndResource('cmnu', i);
            FailNil(cmnuHandle);
            GetResInfo(cmnuHandle, menuID, menuType, name);
            FailResError;
            ConvertToMenu(cmnuHandle, menuID, @CallAddToTable);
            END;

        IF fProgress THEN
            BEGIN
            WriteLn('All cmnu resources processed; about to sort');
            END;

        {Sort the command table}
        FOR i := 1 TO fTableIndex DO
            FOR j := i TO fTableIndex DO
                IF fTableHandle^^[i].cmd > fTableHandle^^[j].cmd THEN
                    BEGIN
                    temp := fTableHandle^^[i];
                    fTableHandle^^[i] := fTableHandle^^[j];
                    fTableHandle^^[j] := temp;
                    END;

        SetHandleSize(Handle(fTableHandle), fTableIndex * sizeof(tableRec));
        FailMemError;

        tempH := GetResource(kMNTBbyCmdNumber, kIDMNTBbyCmdNumber);
        IF tempH <> NIL THEN
            RmveResource(tempH);
        AddResource(Handle(fTableHandle), kMNTBbyCmdNumber, kIDMNTBbyCmdNumber, '');

        IF fProgress THEN
            BEGIN
            WriteLn('COMMAND TABLE:');
            WriteLn('Cmd#  Menu# Item#');
            FOR i := 1 TO fTableIndex DO
                WriteLn(fTableHandle^^[i].cmd: 4, fTableHandle^^[i].menu: 6, fTableHandle^^[i].item: 6);
            END;

        DoAutoMagicCreatorAndBundle;

        CloseResFile(ref);
        FailResError;
        END;

    {$S TRes}

    BEGIN
    InitUMPWTool;

    New(gPostRezTool);
    FailNil(gPostRezTool);
    gPostRezTool.IPostRezTool;
    gPostRezTool.Run;
    END.